VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsHotKey"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const HOTKEY_CLASSA As String = "msctls_hotkey32"
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hWnd As Long) As Long

Private Const WS_CHILD As Long = &H40000000
Private Const WS_TABSTOP As Long = &H10000
Private Const WS_VISIBLE As Long = &H10000000

Private Const WM_SETFONT As Long = &H30
Private Const WM_USER As Long = &H400
Private Const HKM_SETHOTKEY As Long = (WM_USER + 1)
Private Const HKM_GETHOTKEY As Long = (WM_USER + 2)

Private m_hWnd As Long

Friend Sub Create(ByVal hWndParent As Long, ByVal nLeft As Long, ByVal nTop As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal obj As IFont, Optional ByVal Key As KeyCodeConstants)
Destroy
'///
m_hWnd = CreateWindowEx(0, HOTKEY_CLASSA, vbNullChar, WS_CHILD Or WS_TABSTOP Or WS_VISIBLE, _
nLeft, nTop, nWidth, nHeight, hWndParent, 0, App.hInstance, ByVal 0)
If m_hWnd Then
 SendMessage m_hWnd, WM_SETFONT, obj.hFont, ByVal 0
 If Key Then SendMessage m_hWnd, HKM_SETHOTKEY, Key And &HFF&, ByVal 0
End If
End Sub

Friend Sub Destroy()
If m_hWnd Then
 DestroyWindow m_hWnd
 m_hWnd = 0
End If
End Sub

Friend Property Get HotKey() As KeyCodeConstants
If m_hWnd Then HotKey = SendMessage(m_hWnd, HKM_GETHOTKEY, 0, ByVal 0) And &HFF&
End Property

Friend Property Let HotKey(ByVal Key As KeyCodeConstants)
If m_hWnd Then SendMessage m_hWnd, HKM_SETHOTKEY, Key And &HFF&, ByVal 0
End Property

Private Sub Class_Terminate()
Destroy
End Sub
